! some of this won't work in F90...use F95
program newfun
   open(unit=11, form="formatted", file="lesson4.txt")
   call try_loops
   call try_stuff
   call try_string
end program newfun

subroutine try_loops
   use precision
   implicit none
   integer(normal), parameter:: n = 10
   real(adequate), dimension(n):: x, y, z
   logical, dimension(n):: cond
   integer i, j, k
   real(adequate):: w1, w2, t

   x = (/ (i, i=1, n) /)
   y = sqrt(x**2/3.0)

   !the old way
   t = x(1)
   k = 1
   do i = 2, n
      if(x(i) > t) then
	     t = x(i)
		 k = i
	  endif
   enddo
   
   !new way #1
   t = x(1)
   k = 1
   do i = 2, n
      if(x(i) <= t) cycle
	  t = x(i)
	  k = i
   enddo

   !new way #2
   t = minval(x)
   k = minloc(x, 1)

   !Exit has a new meaning...
   t = 12.0
   k = 0
   do i = 1, n
      if(x(i) == t) then
	     k = i
		 exit
	  endif
   enddo

   !or ...
   k = 0
   do while(k /= 0)
      if(x(i) == t) k = i
   end do

   w1 = minval (x)
   w2 = maxval (x)
   t = 0.0
   do j = 1, n
      if (y(j) > w2) cycle
      if (w1 <= y(j)) then
	     t = t + y(j)
	  endif
   enddo
   write(11, *) "Sum of y elements within x range is ", t

   where (w1 <= y .and. y <= w2)
      z = y
   elsewhere
      z = 0.0
   end where
   write(11, *) "Same thing, without a loop ", sum(z)

   z = 0.0
   cond = w1 <= y .and. y <=w2
   where (cond) z = y
   write(11, *) "Same thing, using where statement ", sum(z)

   where(cond)
      z = f(x)
   elsewhere
      z = 0.0
   endwhere
   write(11, *) "Same thing, using elemental function ", sum(z)

   x = x - 4.0 ! make some values negative
   w1 = 0.0
   cond = w1 <= y .and. y <= w2
   where(cond)
      z = f(x)
   elsewhere
      z = 0.0
   endwhere
   write(11, *) "f(x) not evaluated at bad points ", sum(z)

   contains

   elemental function f(x)
   real(adequate), intent(in):: x
   real(adequate):: f
   f = sqrt(x**2 / 3.0)
   end function f
     
end subroutine try_loops

subroutine try_stuff
   use precision
   implicit none
   integer i, j
   integer,parameter:: n = 4, m = 5
   integer a(n,m), b(n,m), c(6), z(n*m)
   namelist /ab/ a, b

   forall(i=1:6) c(i) = 3 - i
   write(11, *) "c ", c

   forall(i=1:n, j=1:m) a(i,j) = 10 * i + j
   write(11, *) "Using forall, a(2,3) ", a(2,3)

   a = 10 * spread(iota(n), dim=2, ncopies=m) + &
            spread(iota(m), dim=1, ncopies=n)
   write(11, *) "Using spread, a(2,3) ", a(2,3)

   b = 0
   forall(i=1:n, j=1:m, a(i,j) > 22) b(i,j) = 1.0
   write(11, NML=ab)

   forall(i=1:n, j=1:m)
      a(i,j) = i + j
	  b(i,j) = i - j
   end forall 
   write(11, NML=ab)

   write(11, *) "reshape(iota(6), (/ 2, 3 /)"
   write(11, *) reshape(iota(6), (/ 2, 3 /))

   write(11, *) "reshape(iota(6), (/ 2, 4 /), (/0, 0/), (/2, 1/))"
   write(11, *) reshape(iota(6), (/ 2, 4 /), (/0, 0/), (/2, 1/))

   z = reshape(a, (/ size(a) /))
   write(11, *) "z ", z

   z = transfer(a,a)
   write(11, *) "z ",z

   write(11, *) "shape(a)", shape(a)
   write(11, *) "sum(a,1) ", sum(a,1)
   write(11, *) "sum(a,2) ", sum(a,2)
   write(11, *) "sum(a)", sum(a)

   contains 
      function iota(size)
         integer size, i
         integer iota(size)
         iota = (/ (i, i=1, size) /)
      end function
end subroutine try_stuff

subroutine try_string
! try the ISO varying_string
   use iso_varying_string
   implicit none
   type(varying_string) s, t, u
   s = "hello"
   t = "world"
   u = s // var_str(" ") // t
   write(11, *) char(u)
end subroutine try_string

